home *** CD-ROM | disk | FTP | other *** search
/ Acorn User: China / Acorn User China CD-ROM (UK) (Disc B) / Acorn User China CD-ROM (UK) (Disc B).bin / STUTTGART / EDITORS / LEDIT / !lEdit_l_lispmode < prev    next >
Encoding:
Text File  |  1995-01-21  |  19.6 KB  |  570 lines
  1. ;;;                  ***  lEdit - Lisp Editor  ***
  2. ;;;                       (c) 1995 Urs Bisang
  3. ;;;                          Version 0.1  
  4. ;;;
  5. ;;;   dieses file enthaelt die routinen und handler speziell fuer
  6. ;;;   den lisp modus von ledit! 
  7. ;;;
  8.                                      
  9.  
  10. ;;; *** globale variablen ***
  11.  
  12. ;; der name eines neuen text buffers
  13. (define *lisp-untitled-name* "<untitled>")
  14.                                
  15. ;; default werte des options menu
  16. (define *lisp-options-pause* 1.0)
  17.  
  18. ;; der name des lisp modes
  19. (define *lisp-mode-name* 'Lisp)
  20.  
  21. ;; default name zum speichern von lisp files
  22. (define *lisp-default-name* "LispFile")
  23.  
  24. ;; ** globale state variablen fuer das options menu **
  25.  
  26. ;; automatisches paren matching nach eingabe einer
  27. ;; schliessenden klammer
  28. (define *lisp-option-match* #t)
  29.  
  30. ;; automatisches einruecken nach dem eingabe von return
  31. (define *lisp-option-ident* #t)
  32.  
  33. ;; flag fuer animation beim einruecken
  34. (define *lisp-option-animate* #t)
  35.  
  36. ;; flag fuer spezielles einruecken (shift-TAB!) 
  37. (define *lisp-special-ident* #f)
  38.  
  39.  
  40. ;;; ***  lisp editor window menus ***
  41.              
  42. ;; ** misc submenu **  
  43.  
  44. (define lisp-misc-submenu
  45.   (menu-new "Misc" ">Info,New view,Print,Undo     F8,Redo     F9"))
  46.  
  47. ;; handle die submenu eintraege
  48. (define (lisp-handle-misc-submenu item text)
  49.    (let ((i (menu-subitem item)))
  50.      (cond 
  51.        ((menu-item i 1) (show-proginfo))
  52.        ((menu-item i 2) (text-new-view text))
  53.        ((menu-item i 3) (text-print text))
  54.        ((menu-item i 4) (txt-undo text))
  55.        ((menu-item i 5) (txt-redo text)))))
  56.  
  57.  
  58. ;; ** save submenu **
  59.           
  60. ;; handle die submenu eintraege
  61. (define (lisp-handle-save-submenu item text)
  62.   (cond 
  63.     ((= (length item) 2) (text-saveas text))
  64.     ((= (length item) 1) (text-save text))
  65.     (else (ierr "bad save selection"))))
  66.  
  67.  
  68. ;; ** select submenu **
  69.  
  70. (define lisp-select-submenu
  71.   (menu-new "Select" ">Save,Print,Copy   ^C,Move   ^V,Delete ^X,Clear  ^Z"))
  72.  
  73. ;; update submenu bevor es angezeigt wird
  74. (define (lisp-update-select-submenu)
  75.   ;; falls keine text-selection vorliegt mache die
  76.   ;; entsprechenden menu Eintraege nicht selektierbar
  77.   (if (txtscrap-selectowner)
  78.       (menu-change lisp-select-submenu
  79.         setflags: 0 0 entry: 1
  80.         setflags: 0 0 entry: 2
  81.         setflags: 0 0 entry: 3
  82.         setflags: 0 0 entry: 4
  83.         setflags: 0 0 entry: 5
  84.         setflags: 0 0 entry: 6)
  85.       (menu-change lisp-select-submenu
  86.         setflags: 0 1 entry: 1
  87.         setflags: 0 1 entry: 2
  88.         setflags: 0 1 entry: 3
  89.         setflags: 0 1 entry: 4
  90.         setflags: 0 1 entry: 5
  91.         setflags: 0 1 entry: 6))) 
  92.  
  93. ;; handle die submenu eintraege
  94. (define (lisp-handle-select-submenu item text)
  95.   (let ((i (menu-subitem item)))
  96.     (cond            
  97.       ((menu-item i 1)  (text-save-selection text))
  98.       ((menu-item i 2)  (text-print-selection text))
  99.       ((menu-item i 3)  (text-copy-selection text))
  100.       ((menu-item i 4)  (text-move-selection text))
  101.       ((menu-item i 5)  (text-delete-selection))
  102.       ((menu-item i 6)  (text-clear-selection)))))
  103.  
  104.  
  105. ;; ** edit submenu **
  106.  
  107. (define lisp-edit-submenu
  108.   (menu-new "Edit" (string-concat
  109.                      ">Find        F4,>Goto        F5,>Replace     F6," 
  110.                      "Ident      TAB,RecIdent    ^R,Match ()    ^M,"
  111.                      "Next (      ^A,Previous (  ^S,Next )      ^D,"
  112.                      "Previous )  ^F")))
  113.  
  114. ;; handle die submenu eintraege
  115. (define (lisp-handle-edit-submenu item text)
  116.   (let ((i (menu-subitem item)))
  117.     (cond            
  118.       ((menu-item i 1)  (text-find-dbox text))
  119.       ((menu-item i 2)  (text-goto-dbox text))
  120.       ((menu-item i 3)  (text-replace-dbox text))
  121.       ((menu-item i 4)  (lisp-identline text))
  122.       ((menu-item i 5)  (lisp-rec-identline text))
  123.       ((menu-item i 6)  (lisp-ctrl-m text))
  124.       ((menu-item i 7)  (lisp-next-opening-paren text))
  125.       ((menu-item i 8)  (lisp-previous-opening-paren text))
  126.       ((menu-item i 9)  (lisp-next-closing-paren text))
  127.       ((menu-item i 10) (lisp-previous-closing-paren text)))))
  128.  
  129.  
  130. ;; ** options submenu **
  131.  
  132. (define lisp-options-submenu
  133.   (menu-new "Options" "Ident,Match (),Animate"))
  134.  
  135. ;; update submenu bevor es angezeigt wird
  136. (define (lisp-update-options-submenu) 
  137.   (menu-change lisp-options-submenu 
  138.                setflags: (if *lisp-option-ident* 1 0) 0 entry: 1)
  139.   (menu-change lisp-options-submenu 
  140.                setflags: (if *lisp-option-match* 1 0) 0 entry: 2)
  141.   (menu-change lisp-options-submenu 
  142.                setflags: (if *lisp-option-animate* 1 0) 0 entry: 3))
  143.  
  144. ;; handle die submenu eintraege
  145. (define (lisp-handle-options-submenu item text)
  146.   (let ((i (menu-subitem item)))
  147.     (cond            
  148.       ((menu-item i 1)  (set! *lisp-option-ident*
  149.                               (not *lisp-option-ident*)))
  150.       ((menu-item i 2)  (set! *lisp-option-match*
  151.                               (not *lisp-option-match*)))
  152.       ((menu-item i 3)  (set! *lisp-option-animate*
  153.                               (not *lisp-option-animate*))))))
  154.  
  155. ;; ** das haupt menu fuer den lisp mode **
  156.  
  157. (define lisp-ledit-menu
  158.   (menu-new "lEdit" "Misc,>Save    F3,Select,Edit,Options")) 
  159.  
  160. (menu-change lisp-ledit-menu
  161.              submenu: lisp-misc-submenu entry: 1
  162.              submenu: lisp-select-submenu entry: 3
  163.              submenu: lisp-edit-submenu entry: 4
  164.              submenu: lisp-options-submenu entry: 5) 
  165.                                 
  166. ;; der handler und maker fuer das editor window menu
  167. (define (lisp-ledit-menu-maker&handler item text)
  168.    (cond 
  169.      ((equal? item :make-menu) (lisp-ledit-menu-maker text))
  170.      ((menu-item item 1) (lisp-handle-misc-submenu item text))
  171.      ((menu-item item 2) (lisp-handle-save-submenu item text))
  172.      ((menu-item item 3) (lisp-handle-select-submenu item text))
  173.      ((menu-item item 4) (lisp-handle-edit-submenu item text))
  174.      ((menu-item item 5) (lisp-handle-options-submenu item text))
  175.      (else (ierr "unknown menu item"))))
  176.                                           
  177. ;; der maker fuer das editor window menu
  178. (define (lisp-ledit-menu-maker text)  
  179.   (lisp-update-select-submenu)
  180.   (lisp-update-options-submenu)
  181.   lisp-ledit-menu)
  182.  
  183.  
  184. ;; lade ein  lisp file und zeige es in einem neuen window an.
  185. ;; pruefe ob das file schon mal geladen wurde
  186. (define (lisp-load-file filename)
  187.   (if (not (text-file-loaded? filename)) ; schon geladen ?
  188.       (let ((text (gensym)))
  189.         (set-eval! text (txt-new "")) 
  190.         (setp! text 'modename *lisp-mode-name*)
  191.         (setp! text 'defaultname *lisp-default-name*)
  192.         (setp! text 'filename filename)
  193.         (setp! text 'update-handler text-update-title)
  194.         (text-update-title text)
  195.         (txt-eventhandler  text lisp-event-handler)
  196.         (event-attachmenumaker (txt-syshandle text)         
  197.                                lisp-ledit-menu-maker&handler
  198.                                text)
  199.         (txt-show text)
  200.         (if (not (txt-load text filename 0 #t))
  201.             (werr 0 "can't load file '" filename "'"))
  202.         (text-cursor-home text) ; zeige den anfang des files
  203.         (txt-setcharoptions text 4 0) ; file nicht upgedated !
  204.         (set! *text-bufferlist* (cons text *text-bufferlist*))))) 
  205.  
  206.  
  207. ;;  oeffne ein neues editor window und trage den buffer 
  208. ;;  in die text buffer liste ein
  209. (define (lisp-new-editor-window) 
  210.  (let ((text (gensym)))
  211.    (set-eval! text (txt-new "")) 
  212.    (setp! text 'modename *lisp-mode-name*)
  213.    (setp! text 'defaultname *lisp-default-name*)
  214.    (setp! text 'update-handler text-update-title)
  215.    (text-update-title text)
  216.    (txt-eventhandler  text lisp-event-handler)
  217.    (event-attachmenumaker (txt-syshandle text)         
  218.                           lisp-ledit-menu-maker&handler
  219.                           text)
  220.    (txt-show text)
  221.    (set! *text-bufferlist* (cons text *text-bufferlist*)))) 
  222.                                                  
  223.        
  224. ;; ** der default handler fuer mouse events  **
  225.  
  226. (define (lisp-handle-mouse text x) 
  227.   (cond
  228.     ((txt-icon-dragged? x)     (text-insert-dragged-file text))
  229.     ((txt-select-clicked? x)   (lisp-select-clicked text x))
  230.     ((txt-adjust-clicked? x)   (if (txt-selectset text)
  231.                                    (lisp-adjust-pressed text x)))  
  232.     ((txt-closeicon? x)        (text-close-window text))
  233.     ((txt-scrollarrow-up? x)   (txt-movevertical text -1 1))
  234.     ((txt-scrollarrow-down? x) (txt-movevertical text 1 1))
  235.     ((txt-scrollbar-up? x)     (text-cursor-pageup text))
  236.     ((txt-scrollbar-down? x)   (text-cursor-pagedown text))
  237.     ((txt-select-pressed? x)   (lisp-select-pressed text x))
  238.     ((txt-adjust-pressed? x)   (lisp-adjust-pressed text x))
  239.     (else (wimp-processkey x))))
  240.  
  241.  
  242. ;; ** routinen zur behandlung der mouse events **
  243.  
  244.  
  245. ;; select clicked innerhalb des editor windows
  246. (define (lisp-select-clicked text x)
  247.    ;; setze cursor an die click position
  248.   (txt-setdot text (txt-mouse-position x))
  249.   ;; mach window aktiv (setze input focus!)
  250.   (txt-setcharoptions text 2 2))
  251.  
  252. ;; selcet pressed innerhalb des editor windows. 
  253. ;; mache eine text selektion
  254. (define (lisp-select-pressed text x)
  255.   (let ((start (txt-dot text))
  256.         (end (txt-mouse-position x)))
  257.      (if (< start end)
  258.          (txtscrap-setselect text start end)
  259.          (txtscrap-setselect text end start))))
  260.  
  261.  
  262. ;; adjust pressed innerhalb des editor windows
  263. ;; veraendere eine text selektion
  264. (define (lisp-adjust-pressed text x)
  265.   (let ((old-start (txt-selectstart text))
  266.         (old-end   (txt-selectend text))
  267.         (new-val   (txt-mouse-position x)))
  268.     (cond 
  269.       ((> new-val old-end) (txtscrap-setselect text old-start new-val))
  270.       ((< new-val old-start)   (txtscrap-setselect text new-val old-end))
  271.       ((< (- old-end new-val) (- new-val old-start))
  272.        (txtscrap-setselect text old-start new-val))
  273.       (else (txtscrap-setselect text new-val old-end)))))
  274.  
  275.  
  276.  
  277. ;;; *** der default input event handler ***
  278.  
  279. (define (lisp-event-handler text) 
  280.   (let ((x (txt-get text)))
  281.    (cond 
  282.      ;; behandle mouse events getrennt
  283.      ((txt-mouse-event? x) (lisp-handle-mouse text x)) 
  284.      
  285.      ;; behandle home und page up und page down
  286.      ((txt-key-home? x) (text-cursor-home text))
  287.      
  288.      ;; behandle arrow keys
  289.      ((txt-key-up? x) (txt-movevertical text -1 0))
  290.      ((txt-key-down? x) (txt-movevertical text 1 0))
  291.      ((txt-key-left? x) (txt-movedot text -1)) 
  292.      ((txt-key-right? x) (txt-movedot text 1))
  293.      ((txt-key-ctrl-up? x) (text-cursor-home text))
  294.      ((txt-key-ctrl-down? x) (text-cursor-end text))
  295.      ((txt-key-ctrl-left? x) (txt-setdot text (txt-begin-of-line text))
  296.                              (txt-movedot text (txt-identlevel text)))
  297.      ((txt-key-ctrl-right? x) (txt-setdot text (txt-end-of-line text)))
  298.  
  299.      ;; behandle page up und page down
  300.      ((txt-key-pagedown? x) (text-cursor-pagedown text))
  301.      ((txt-key-pageup? x) (text-cursor-pageup text))
  302.  
  303.      ;; behandle delete, backspace und (copy)
  304.      ((txt-key-delete? x) (lisp-delete* text))
  305.      ((txt-key-backspace? x) (lisp-delete* text))
  306.      ((txt-key-copy? x) (lisp-delete text)) 
  307.      
  308.      ;; behandle tabulator
  309.      ((txt-key-tab? x) (lisp-identline text))
  310.      ((txt-key-shift-tab? x) (let ((*lisp-special-ident* #t))
  311.                                (lisp-identline text)))                               
  312.      ;; behandle die function-keys
  313.      ((txt-key-functionkey? x) (lisp-handle-functionkeys text x))
  314.  
  315.      ;; behandle die ctrl-key tastenkombinationen
  316.      ((akbd-pollctl)  (lisp-handle-ctrlkeys text x))
  317.  
  318.      ;; behandle return taste speziell, wegen identing
  319.      ((txt-key-return? x) (lisp-handle-return text))
  320.  
  321.      ;; behandle die schliessende klammer speziell
  322.      ((= x #\)) (lisp-insert-paren text)) 
  323.  
  324.      ;; behandle normale buchstaben, d.h. fuege sie beim cursor 
  325.      ;; ein und bewege cursor nach rechts 
  326.      ((txt-key-char? x) (txt-insertchar* text x))
  327.      (else (wimp-processkey x)))))
  328.  
  329. ;; ** routinen zur behandlung der keyboard events **
  330.                                     
  331. ;; ist es ein spezial kontext, wo die klammern einzeln
  332. ;; interpretiert werden und nicht als klammern paare? 
  333. ;; zum beispiel in kommentaren, strings, etc.
  334. (define (lisp-special-context? text)
  335.   (let ((i (txt-dot text)))
  336.     (or (txt-lisp-comment? text i)
  337.         (txt-lisp-charconst? text i)
  338.         (txt-lisp-string? text i))))
  339.  
  340.  
  341. ;; insert closing paren and highlight matching paren! 
  342. (define (lisp-insert-paren text)
  343.   (if (lisp-special-context? text)
  344.       (txt-insertchar* text #\))
  345.       (begin 
  346.         (txt-insertchar text #\))
  347.         (lisp-highlight-paren text (txt-dot text))
  348.         (txt-movedot text 1))))
  349.  
  350.  
  351. ;; highlight matching paren 
  352. (define (lisp-highlight-paren text i)
  353.   (let ((j (txt-lisp-matchparen text i)))
  354.     (cond ((and j *lisp-option-match*)
  355.              (txt-setdot text j)
  356.              (delay *lisp-options-pause*)
  357.              (txt-setdot text i)))))
  358.  
  359.  
  360. ;; highlight matching paren
  361. (define (lisp-ctrl-m text)
  362.   (let ((i (txt-dot text))
  363.         (j (cond ((and (> i 0) (= (txt-charat text (- i 1)) #\))) 
  364.                   (txt-lisp-matchparen text (- i 1)))
  365.                  ((= (txt-charat text i) #\()
  366.                   (if (txt-lisp-matchparen text i)
  367.                       (+ (txt-lisp-matchparen text i) 1)))
  368.                  (else #f))))
  369.     (cond (j (txt-setdot text j)
  370.              (delay *lisp-options-pause*)
  371.              (txt-setdot text i)))))
  372.  
  373.  
  374. ;; gehe zur naechsten oeffnenden klammer 
  375. (define (lisp-next-opening-paren text)
  376.   (txt-movedot text 1)
  377.   (let ((i (txt-lisp-nextparen text :forward #\()))
  378.     (if i 
  379.         (txt-setdot text i)
  380.         (txt-movedot text -1))))
  381.  
  382.  
  383. ;; gehe zur vorhergehenden (matching) oeffnenden klammer
  384. (define (lisp-previous-opening-paren text)
  385.   (txt-movedot text -1)
  386.   (let ((i (txt-lisp-nextparen text :backward #\)))
  387.         (j (if i (txt-lisp-matchparen text i) #f)))
  388.     (if j 
  389.         (txt-setdot text j)
  390.         (txt-movedot text 1))))
  391.  
  392.  
  393. ;; gehe zur naechsten (matching) schliessenden klammer 
  394. (define (lisp-next-closing-paren text)
  395.   (let ((i (txt-lisp-nextparen text :forward #\())
  396.         (j (if i (txt-lisp-matchparen text i) #f)))
  397.     (if j (txt-setdot text (+ j 1)))))
  398.   
  399.  
  400. ;; gehe zur vorhergehenden schliessenden klammer
  401. (define (lisp-previous-closing-paren text)
  402.   (txt-movedot text -2)
  403.   (let ((i (txt-lisp-nextparen text :backward #\))))
  404.     (if i 
  405.         (txt-setdot text (+ i 1))
  406.         (txt-movedot text 2)))) 
  407.  
  408. ;; wie ctrl-m aber der cursor wird zusaetzlich um 1 bewegt
  409. (define (lisp-ctrl-n text)
  410.   (lisp-ctrl-m text)
  411.   (delay 1.8)
  412.   (txt-movedot text 1)) 
  413.     
  414. ;; loesche text in einem text buffer unter beruecksichtigung
  415. ;; der regeln fuer lisp klammern nach dem cursor
  416. (define (lisp-delete text)
  417.   (let ((ch (txt-charatdot text))) 
  418.     (if (= ch #\))
  419.         ;; behandle schliessende klammer gesondert
  420.         (lisp-delete-paren text)
  421.         ;; loesche das zeichen beim cursor
  422.         (txt-delete text 1))))
  423.  
  424.  
  425. ;; loesche ein zeichen in einem text buffer unter beruecksichtigung
  426. ;; der regeln fuer klammern vor dem cursor
  427. (define (lisp-delete* text) 
  428.   (if (< 0 (txt-dot text))
  429.       ;; behandle schliessende klammer gesondert
  430.       (if (= (txt-charat text (- (txt-dot text) 1)) #\))
  431.           (lisp-delete-paren* text)
  432.           ;; loesche das zeichen vor dem cursor
  433.           (txt-delete* text 1))))
  434.         
  435.        
  436. ;; loesche eine klammer oder ein klammernpaar nach dem cursor
  437. (define (lisp-delete-paren text)
  438.   (if (not (lisp-special-context? text))
  439.       (lisp-highlight-paren text (txt-dot text)))
  440.   (txt-delete text 1))
  441.  
  442. ;; loesche eine klammer oder ein klammernpaar vor dem cursor
  443. (define (lisp-delete-paren* text)
  444.   (txt-movedot text -1)
  445.   (if (not (lisp-special-context? text))
  446.       (lisp-highlight-paren text (txt-dot text)))
  447.   (txt-movedot text 1)
  448.   (txt-delete* text 1))
  449.  
  450.  
  451.  
  452. ;; behandle die ctrl-key tastenkombinationen
  453. (define (lisp-handle-ctrlkeys text x)
  454.   (cond   
  455.     ((= x #x1a) (text-clear-selection))              ; Ctrl-Z
  456.     ((= x #x18) (text-delete-selection))             ; Ctrl-X
  457.     ((= x #x03) (text-copy-selection text))          ; Ctrl-C
  458.     ((= x #x16) (text-move-selection text))          ; Ctrl-V
  459.     ((= x #x0d) (lisp-ctrl-m text))                  ; Ctrl-M
  460.     ((= x #x0e) (lisp-ctrl-n text))                  ; Ctrl-N
  461.     ((= x #x12) (lisp-rec-identline text))           ; Ctrl-R
  462.     ((= x #x01) (lisp-next-opening-paren text))      ; Ctrl-A
  463.     ((= x #x13) (lisp-previous-opening-paren text))  ; Ctrl-S
  464.     ((= x #x04) (lisp-next-closing-paren text))      ; Ctrl-D
  465.     ((= x #x06) (lisp-previous-closing-paren text))  ; Ctrl-F
  466.     (else (wimp-processkey x))))
  467.  
  468.  
  469. ;; behandle die function keys
  470. (define (lisp-handle-functionkeys text x)
  471.   (let ((key (txt-key-functionkey? x)))
  472.     (cond
  473.       ((= key 3) (text-saveas text))
  474.       ((= key 4) (text-find-dbox text))
  475.       ((= key 5) (text-goto-dbox text))
  476.       ((= key 6) (text-replace-dbox text))
  477.       ((= key 8) (txt-undo text))
  478.       ((= key 9) (txt-redo text))
  479.       (else      (wimp-processkey x)))))
  480.  
  481.  
  482. ;;; ** routinen fuers lisp identing **
  483.  
  484. ;; gib newline aus und ident die zeile entsprechend den 
  485. ;; vorhergehenden zeilen
  486. (define (lisp-handle-return text)
  487.   (if *lisp-option-ident*
  488.       (let ((i (txt-lisp-calcident text)))
  489.         (if i
  490.             (lisp-newline text i)
  491.             (begin 
  492.               (werr 0 "paren mismatch - can't ident correctly")
  493.               (lisp-newline text 0))))
  494.       (lisp-newline text 0)))
  495.  
  496. ;; gib newline aus und ruecke neue zeile eine
  497. (define (lisp-newline text n)
  498.   (txt-newline text)
  499.   (if (not *lisp-option-animate*)
  500.       (text-dont-update text))  
  501.   (txt-insertspaces text n)
  502.   (if (not *lisp-option-animate*)
  503.       (text-update text)))
  504.                
  505. ;; ruecke zeile entsprechend den regeln ein 
  506. (define (lisp-identline text)
  507.   (let ((old-pos (txt-dot text))
  508.         (old-ilevel (txt-identlevel text))
  509.         (new-ilevel 0))
  510.     (if (not *lisp-option-animate*)
  511.         (text-dont-update text))
  512.     (txt-setdot text (txt-begin-of-line text))
  513.     (cond ((> (txt-dot text) 0) 
  514.            (txt-movedot text -1)
  515.            (set! new-ilevel (txt-lisp-calcident text))
  516.            (txt-movedot text 1)
  517.            (cond (new-ilevel 
  518.                    (txt-delete text old-ilevel)
  519.                    (txt-insertspaces text new-ilevel)
  520.                    (txt-setdot text (+ old-pos (- new-ilevel old-ilevel))))
  521.                  (else (werr 0 "paren mismatch - can't ident correctly")
  522.                        (txt-setdot text old-pos))))
  523.            (else (txt-setdot text old-pos)))
  524.     (if (not *lisp-option-animate*)
  525.         (text-update text))))
  526.                 
  527.  
  528. ;; ruecke zeilen rekursiv entsprechend den regeln ein,
  529. ;; bis eine nichtleere zeile mit zero identing gefunden wird
  530. (define (lisp-rec-identline text)
  531.   (if (not *lisp-option-animate*)
  532.       (text-dont-update text))
  533.   (let ((*lisp-option-animate* #t))          ; shadow old value
  534.     (lisp-identline text)
  535.     (let ((reset-pos (txt-dot text))
  536.           (old-pos reset-pos))
  537.       (txt-setdot text (txt-begin-of-line text))
  538.       (txt-movevertical text 1 0)
  539.       (while (and (\= old-pos (txt-dot text))
  540.                   (or (txt-emptyline? text)
  541.                       (\= (txt-identlevel text) 0)))
  542.              (lisp-identline text)
  543.              (set! old-pos (txt-dot text)) 
  544.              (txt-movevertical text 1 0))
  545.       (txt-setdot text reset-pos)))
  546.   (if (not *lisp-option-animate*)
  547.       (text-update text)))
  548.            
  549.         
  550. ;; die hook funktion fuers lisp identing
  551. (define (txt-lisp-ident-hook token)
  552.   (cond (*lisp-special-ident* (- 1 (length token)))
  553.         ;; token fuer wtk
  554.         ((equal? token "lambda") -5)
  555.         ((equal? token "define") -5)
  556.         ((equal? token "let")    -2)
  557.         ((equal? token "define-syntax") -12)
  558.         ;; zusaetzliche token fuer scheme
  559.         ((equal? token "let*")   -3)
  560.         ((equal? token "letrec") -5)
  561.         ;; einige token fuer common lisp
  562.         ((equal? token "defun")  -4)
  563.         ((equal? token "defvar") -5)
  564.         ((equal? token "defconst") -7)
  565.         ((equal? token "defmacro") -7)
  566.         ((equal? token "defclass") -7)
  567.         ((equal? token "defmethod") -8)
  568.         (else #f)))
  569.  
  570.